home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1994 / MacHack 1994.toast / MacHack™ 1987-1994 / MacHack™ '92 / Hacks ’92 / tclObjNameƒ / tclObjName.c < prev    next >
Encoding:
Text File  |  1992-06-17  |  10.7 KB  |  391 lines  |  [TEXT/MPS ]
  1. /*
  2. From: bhamlin@netcom.com (Brian Hamlin)
  3. To: tcl-talk@brown.edu, shayer@applelink.apple.com
  4. Subject:  debugging DCMD srcs
  5.  
  6.     B. Marshall Hamlin
  7.     Constructor, Noesis Sfwr Construction
  8.     
  9.     6300 Leona St
  10.     Oakland, CA  94605-1228
  11.  
  12. All:
  13.  
  14.   Have you ever been frustrated in debugging TCL situations, breaking
  15. on something like CView::Activate() 27 times, and on the 28th low-and-
  16. behold there is your bug, but the debugger tells you the object is a,
  17. you guessed it, CView!  The stack crawl is ok, if you can see past some
  18. factorial number of DispatchClicks, DoCommands and the like. What *I* 
  19. really wanted was the name of my !@^%#$& object !
  20.  
  21.   So here it is: a DCMD that gives the name of an object, passed the
  22. object's *actual* address in the heap (when the debugger says 
  23. struct 0x0112345)
  24.  
  25.   NOTE: executing Debugger macro __cn(this) shows the current 
  26.   object's name in the src level debugger (!)
  27.  
  28. */
  29.  
  30. /*
  31.   tclObjName  DCMD
  32.   
  33.   USAGE:
  34.   
  35.     pass in the addr of an object on the heap and this dcmd returns 
  36.   the object's class name.  A5 must be current.
  37.  
  38.     pass in no address and this DCMD looks through the application
  39.   heap for possible tcl objects and writes a list to output.
  40.  
  41.     TCL Library code for class_name(). Given the short in the first two 
  42.   bytes of the object handle, return the address of the class name in D0.
  43.  
  44.     MOVEA   4(A7),A0    ; get object ID
  45.     ADDA.L  A5,A0       ; find ptr at ID(A5)
  46.     MOVEQ   #1,D0       ;
  47.     ADD     (A0)+,D0    ; off2 = *p + 1
  48.     LSL     #2,D0       ; off2 *= 4
  49.     ADDA.W  D0,A0       ; find obj record
  50.     MOVEQ   #16,D0      ; name at offset 0x10
  51.     ADD.L   A0,D0       ; return name ptr
  52.     RTS  
  53.  
  54.  
  55.   FIX:
  56.   
  57.     -detect non ascii chars in potential class-name
  58.     -show all _still_ questionable blocks with a '?'
  59.     -find bug in globals !
  60.     -allow a string to be passed as a match patt for class names
  61.  
  62.  
  63.   CREATED:                                              28apr92  bh
  64.  
  65.   Copyright 1992, Noesis
  66.   
  67.   Permission to use, copy, modify, and distribute this software and its
  68.   documentation for any purpose and without fee is hereby granted, provided
  69.   that the above copyright notice appear in all copies and that both that
  70.   copyright notice and this permission notice appear in supporting
  71.   documentation.  This software is provided "as is" without express or
  72.   implied warranty.
  73.  
  74. */
  75.  
  76.                                             //  B E G I N   L I S T I N G
  77. // ***************************************************************************
  78.  
  79. #include <Types.h>
  80. #include "dcmd.h"
  81.  
  82. #define tclBadAddrM(ADDR) (ADDR<*(long*)0x2AA || ADDR>*(long*)0x130)
  83.  
  84. //***************************************************************************
  85.                                            //  F O R W A R D
  86. pascal void   doObjectMap(void);
  87. Boolean       tclBadAddr( long addr);
  88. void          doFindObject( long addr);
  89. pascal void ObjectSearch(long blockAddress, long blockLength, long addrOfMasterPtr, short blockType, Boolean locked, Boolean purgeable, Boolean resource);
  90.  
  91.  
  92.  
  93. //**************************************************************************
  94.                                            //  S T A T I C
  95. static long gObjCnt;
  96. static unsigned long gObjSize;
  97.  
  98. static char gMatchChars[ 34];
  99.  
  100.  
  101. /***************************************************************************
  102.   CommandEntry
  103. ***************************************************************************/
  104. pascal void CommandEntry (dcmdBlock* paramPtr)
  105. {
  106.   long            address;
  107.   short           ch;
  108.   Boolean         ok;
  109.   char              c;
  110.  
  111.  
  112.   switch (paramPtr->request) {
  113.   
  114.     case dcmdInit:
  115.       break;
  116.  
  117.     case dcmdHelp:
  118.       dcmdDrawLine ("\ptclObjName objAddr");
  119.       dcmdDrawLine ("\p   Display class name of a TCL object, bh 19jun92");
  120.       break;
  121.  
  122.     case dcmdDoIt:
  123.     
  124.       gObjCnt = 0;
  125.       gObjSize = 0;
  126.  
  127.       dcmdSwapWorlds();
  128.       if ( paramPtr->registerFile[A5Register] != *(long*)0x904){
  129.         dcmdDrawLine ("\p#tclObjName - A5 world not current");
  130.         return;
  131.       }
  132.     
  133.       // *******************************************************
  134.       // No Params - do a heap map 
  135.       
  136.       if ( (c=dcmdPeekAtNextChar()) == '\n') {
  137.           doObjectMap();
  138.         return;
  139.       }
  140.       
  141.       // *******************************************************
  142.       // Numeric Param - find an address
  143.       
  144.       if ( isdigit(c) ) {
  145.         ch = dcmdGetNextExpression (&address, &ok);
  146.         if (!ok) {
  147.           dcmdDrawLine ("\p#tclObjName - Syntax error");
  148.           return;
  149.         }
  150.         doFindObject( address);
  151.         return;
  152.       }
  153.       
  154.       // *******************************************************
  155.       // Alpha Param - Match a string in Object Name
  156.       
  157.             
  158.       break;
  159.   }
  160. } 
  161.  
  162.  
  163. /***************************************************************************
  164.   tclBadAddr
  165. ***************************************************************************/
  166. Boolean tclBadAddr( long addr)
  167. {
  168.     return (addr<*(long*)0x2AA || addr>*(long*)0x130);
  169. }
  170.  
  171.  
  172. /***************************************************************************
  173.   doFindObject
  174. ***************************************************************************/
  175. void doFindObject( long addr)
  176. {
  177.    unsigned long   p1, p2;
  178.  
  179.   // ******************************************************************
  180.   // Find a single Object's name 
  181.  
  182.   if ( !tclBadAddr( addr)) {
  183.     dcmdDrawLine ("\p#tclObjName - objAddr not in application heap!");
  184.     return;
  185.   }
  186.  
  187.   p1 = *(short*)addr + *(long*)0x904;
  188.   p2 = (*(short*)p1++ + 1)<<2;
  189.   p2 += p1;
  190.   PutCStr( (char*)p2+16);        PutLine();
  191.  
  192.   //dcmdDrawLine( (unsigned char*)((char*)p2+16));  // really a c string
  193.   dcmdDrawLine( "\p*** tclObjName ***");
  194. }
  195.  
  196.  
  197. /***************************************************************************
  198.   ObjectSearch
  199. ***************************************************************************/
  200. pascal void 
  201. ObjectSearch(long blockAddress, long blockLength, long addrOfMasterPtr,
  202.              short blockType, Boolean locked, Boolean purgeable, Boolean resource)
  203. {
  204.     unsigned long   p1, p2;
  205.     char            *s;
  206.     short            cnt, c;
  207.  
  208.     if (blockType != relocatableBlock)
  209.         return;
  210.     //if ( *(short*)blockAddress > 0)
  211.     //    return;
  212.  
  213.     p1 = *(short*)blockAddress + *(long*)0x904;
  214.     //if ( tclBadAddrM( p1)) { PutLine(); return;}
  215.     p2 = (*(short*)p1++ + 1)<<2;
  216.     p2 += p1;
  217.     //if ( tclBadAddr( p2)) { PutLine();  return;}
  218.     s = (char*)p2+16+1;        // what's with the 1 ?
  219.     
  220.     cnt = strlen(s);
  221.     if ( *s < 'A' || *s > 'Z' || cnt < 3 ) { return;}
  222.     for ( c=0;c<cnt;c++)
  223.         if ( !isalpha( s[c]))
  224.             return;
  225.  
  226.     PutChar( (locked)?('L'):(' '));
  227.     PutChar( (blockLength>0x400)?('?'):(' '));
  228.  
  229.     PutCStrTruncTo( s, 32);
  230.     PutSpacesTo( 35);
  231.     //PutUHexZTo( blockLength, 0, 42); 
  232.     PutUHexZ( blockLength, 8);
  233.     PutSpacesTo( 46);
  234.     PutUHexZ( blockAddress, 8);
  235.     PutLine();
  236.  
  237.     gObjCnt++;
  238.     gObjSize += blockLength;
  239.  
  240.     // fake refs section
  241.     if (0) {
  242.         long    l;  Boolean b;
  243.         
  244.         l = blockAddress; l = blockLength; l = addrOfMasterPtr; l = blockType;
  245.         b = locked; b = purgeable; b = resource;
  246.     }
  247.     
  248.     return;
  249. }
  250.  
  251. /***************************************************************************
  252.   doObjectMap
  253. ***************************************************************************/
  254. pascal void doObjectMap()
  255. {
  256.  
  257.     dcmdDrawLine((char*)0x910);
  258.     dcmdDrawLine("\p");
  259.  
  260. //                             1         2         3         4         5         6         7
  261. //                    01234567890123456789012345678901234567890123456789012345678901234567890
  262.     dcmdDrawLine("\p  Object Name                      Size       Addr");
  263.     dcmdDrawLine("\p------------------------------------------------------");
  264.  
  265.     dcmdForAllHeapBlocks( ObjectSearch);
  266.     dcmdDrawLine("\p------------------------------------------------------");
  267.  
  268.     if ( !gObjCnt) {
  269.         dcmdDrawLine("\pNo objects found - Are we really in Kansas, Toto ?");
  270.         dcmdDrawLine("\p");
  271.         return;
  272.     } 
  273.     PutCStr( "Heap Objects found: ");
  274.     PutUDec( gObjCnt);
  275.         PutLine();
  276.     PutCStr( "Heap Objects sizes: ");
  277.     PutUDec( gObjSize);
  278.         PutLine();
  279.     PutCStr( "Total heap size:");
  280.     PutUDec( *(long*)0x130 - *(long*)0x2AA);
  281.         PutLine();
  282.  
  283. }
  284.  
  285.  
  286. // ***************************************************************************
  287. /*                                                        B  U  I  L  D
  288. [
  289.     #getfilename
  290.  
  291.     set dcmdLib 'HD_80:MacsBug 6.2.2:dcmds:dcmd Libraries:'
  292.     set srcDir 'Srcs Shuttle:tclObjNameƒ:'
  293.     
  294.     #set dcmdLib Alliance:MacsBugƒ:dcmdƒ:
  295.     #set srcDir Alliance:Telecom:Netcomƒ:tcl-talk:
  296.  
  297.     #directory {dcmdLib}
  298.     #  C put.c -b
  299.  
  300.     directory "{srcDir}"
  301.  
  302.       C tclObjName.c -b
  303.     Link "{dcmdLib}"dcmdGlue.a.o "{dcmdLib}"put.c.o ∂
  304.             tclObjName.c.o "{dcmdLib}"DRuntime.o ∂
  305.             "{CLibraries}"StdCLib.o "{Libraries}"Interface.o -o tclObjName 
  306.     "{dcmdLib}"BuildDcmd tclObjName 3200
  307.     
  308.     #Rez -ov -a -o 'Alliance:Systemƒ:TMON Folder:HG dcmds & templates'∂
  309.     # tclObjName
  310.     'Alliance:Tools:ResEdit 2.1.1$cs' 'Alliance:Systemƒ:TMON Folder:HG dcmds & templates' tclObjName
  311.  
  312. ]
  313.     
  314.     {dcmdLib}TestDcmd
  315.     
  316.     'Alliance:Tools:ResEdit 2.1.1$cs' {dcmdLib}"Debugger Prefs" tclObjName
  317.  
  318.     dumpobj {Libraries}Interface.o
  319.     dumpobj {CLibraries}StdCLib.o
  320.     set
  321.  
  322.  
  323. -----------------------------------------------------------------------------
  324.     DCMD Put Library
  325.         Copyright © 1988 Apple Computer, Inc.  All rights reserved.
  326. -----------------------------------------------------------------------------
  327.             
  328. o PutLine()
  329.     Write Put Library line buffer to output
  330.  
  331. o PutChar(char c)
  332.     Add 1 char to the line buffer
  333.  
  334. o PutSpace()
  335.     Add 1 space to the line buffer
  336.  
  337. o PutSpacesTo(int pos)
  338.     Add spaces to a position in the line buffer. Tab.
  339.  
  340. o PutBytesTruncTo(const char* s, int len, int pos)
  341.     Put string, ending at a line buffer position. Truncate or pad.
  342.  
  343. o PutBytesTo(const char* s, int len, int pos)
  344.     Put string, writing past position if necessary or pad.
  345.  
  346. o PutCStrTo(const char* s, int pos)
  347.     Write C String to line buffer. Uses PutBytesTo().
  348.  
  349. o PutCStrTruncTo(const char* s, int pos)
  350.     Write string, truncate of necessary. Uses PutBytesTruncTo().
  351.  
  352. o PutCStr(const char* s)
  353.     Write C String to line buffer, never pad.
  354.  
  355. o PutPStrTruncTo(const char* s, int pos)
  356.     Write pascal string, uses PutBytesTruncTo().
  357.  
  358. o PutPStrTo(const char* s, int pos)
  359.     Write pascal string, uses PutBytesTo().
  360.  
  361. o PutPStr(const char* s)
  362.     Write pascal string, uses PutBytesTo().
  363.  
  364. o PutUHexZTo(unsigned long i, int ndig, int pos)
  365.     Write unsigned hex string ending at position.
  366.     ndig -> number of digits in string
  367.     Bug: no check for linepos > pos
  368.  
  369. o PutUHexZ(unsigned long i, int nz)
  370.     Write unsigned hex string, uses PutUHexZTo()
  371.     nz -> number of digits in string
  372.  
  373. o PutUHexWord(unsigned long i)
  374.     Write 2 bytes as Unsigned Hex, uses PutUHexZTo().
  375.  
  376. o PutUDecTo(unsigned long i, int pos)
  377.     Write decimal string ending at position.
  378.     Bug: no check for linepos > pos
  379.  
  380. o PutUDec(unsigned long i)
  381.     Write decimal string, uses PutUDecTo().
  382.  
  383. o PutOSType(unsigned long typ)
  384.     Write 4 bytes as chars, no conversion. Uses PutChar().
  385.     
  386. */
  387. // ***************************************************************************
  388.                                            //  E N D  O F  L I S T I N G
  389.  
  390.  
  391.